package Flap::Schema;
use Flap qw/-m -s -w/;
use constant MULTIPLICITY => {
    '1' => {},
    '?' => {outer => 1},
    '+' => {multi => 1},
    '*' => {multi => 1, outer => 1},
};
use constant RELATION_OPTIONS => {
    -m        => 1,
    -no_cache => 1,
    -no_ddl   => 1,
    -order_by => 1,
};

use Scalar::Util;
my $ISWEAK = \&Scalar::Util::isweak;
my $WEAKEN = \&Scalar::Util::weaken;

sub DESTROY {
    my $row = shift;
    my $d = $row->_data_;
    if($d->{cache} && !$ISWEAK->($d->{cache})){
        $WEAKEN->($d->{cache});
        return $d->{cache}{int $row} = $row if $d->{cache}; #strengthen
    }
    $row->SUPER::DESTROY(@_);
}

sub _add_relation_ {
    my($sch, $t, $m, $rn, $sn, $on, $opt) = @_;
    die $sch->_dmsg_(4, $rn) if $sch->can($rn);
    die $sch->_dmsg_(8, $rn) if !$on;
    my $g = $sch->_global_;
    my $rsch = $sch->_parent_class_->$sn;
    foreach(grep{ $_->{schema} eq $rsch } @{$g->{relations} || []}){
        die qq{Can't defined two relations "$_->{name}" and "$rn" from $sch to $rsch};
    }
    $sch->RELATION_OPTIONS->{$_} || die qq{Invalid option "$_" for $sch->$rn} for keys %$opt;
    
    my $ri = {-m => $m, name => $rn, schema => $rsch, type => $t, %$opt};
    $ri->{_multi} = $sch->_multiplicity_($ri->{-m}, $rn)->{multi};
    
    $on = $sch->_join_on_pk_($rn, "$on = me.%s") if !ref $on;
    my $w = $sch->storage->sql_where($on, my $v = []) || die $sch->_dmsg_(8, $rn);
    $w = $1 while $w =~ /^\s*\((.*)\)\s*\z/s;
    foreach(split /\s+and\s+/i, $w, -1){
        $_ = $1 while /^\s*\((.*)\)\s*\z/s;
        $on = /^\s*(\w+)\.(\w+)\s*=\s*(\w+)\.(\w+)\s*\z/ && (
            ($1 eq $rn && $3 eq 'me' && [$2, $4] || $1 eq 'me' && $3 eq $rn && [$4, $2])
        ) || die qq{Can't parse "$_" for $sch->$rn};
        die $rsch->_dmsg_(5, $on->[0]) if !$rsch->column_info($on->[0]);
        die $sch->_dmsg_(5, $on->[1]) if $on->[1] && !$sch->column_info($on->[1]);
        push @{$ri->{on} ||= []}, $on;
    }
    
    push @{$g->{relations} ||= []}, $g->{relations_hash}{$rn} = $ri;
    $sch->_define_method_($rn, sub{
        @_ > 1 ? shift->set_related($rn, @_) : shift->get_related($rn)
    });
}

sub _add_to_cache_ {
    my $row = shift;
    my $d = $row->_data_;
    my $dc = $d->{cache} ||= do{
        my %dc;
        $WEAKEN->($dc{int $row} = $row);
        \%dc;
    };
    return int $row if !@_;
    
    my $r = shift;
    my $ar = ref $r eq 'ARRAY';
    my($i, @i);
    foreach my $r ($ar ? @$r : $r){
        $d = $r->_data_;
        if(!(my $dc2 = $d->{cache})){
            $d->{cache} = $dc;
        }elsif($dc2 != $dc){
            foreach(keys %$dc2){
                my $r = $dc2->{$_};
                my $d = $r->_data_;
                $ISWEAK->($d->{cache}) ? $WEAKEN->($d->{cache} = $dc) : ($d->{cache} = $dc);
                $ISWEAK->($dc2->{$_}) ? $WEAKEN->($dc->{$_} = $r) : ($dc->{$_} = $r) if !$dc->{$_};
            }
        }
        $WEAKEN->($dc->{$i} = $r) if !$dc->{$i = int $r};
        $ar ? push(@i, $i) : return $i;
    }
    \@i;
}

sub belongs_to {
    die $_[0]->_dmsg_(1) if ref $_[0];
    my($sch, $rn, $sn, $on, $opt) = @_;
    $on = $sch->_join_on_pk_($rn, "%s = me.$on", $sn) if !ref($on ||= $rn.'_id');
    $sch->_add_relation_(belongs_to => 1, $rn, $sn, $on, $opt);
}

sub _del_related_ {
    my($row, $ri, $r) = @_;
    
    if($ri->{_multi}){
        my $rel = $row->{-rel}{$ri->{name}} ||= [[], {}];
        my $i = int $r;
        @{$rel->[0]} = grep{ $_ != $i } @{$rel->[0]};
        $rel->[1]{$i} = 1 if $rel->[1] && ($i = $r->_org_id_);
    }else{
        if($ri->{type} eq 'belongs_to'){
            $row->set_column($_->[1], undef) for @{$ri->{on}};
        }
        $row->{-rel}{$ri->{name}} = undef;
    }
}

sub get_related {
    die $_[0]->_dmsg_(2) if !ref $_[0];
    my($row, $rn) = @_;
    my $rel = $row->{-rel};
    if($rel && exists $rel->{$rn}){
        $rel = $rel->{$rn} || return undef;
        my $dc = $row->_data_->{cache};
        return $dc->{$rel} if !ref $rel;
        return [map{ $dc->{$_} } @{$rel->[0]}] if !$rel->[1];
    }
    
    my $ri = $row->relations_hash->{$rn} || die qq{No such relation: "$rn"};
    my(@on, $nfk);
    foreach(@{$ri->{on}}){
        push @on, my $on = ["$_->[0] = ?", $row->get_column($_->[1])];
        $nfk = 1 if !defined $on->[1];
    }
    
    if($ri->{_multi}){ #has_many
        return [] if $nfk;
        my @r = $ri->{schema}->search({where => \@on, order_by => $ri->{-order_by}});
        $row->set_related($rn, \@r);
        my $dc = $row->_data_->{cache};
        return [map{ $dc->{$_} } @{$row->{-rel}{$rn}[0]}];
    }
    return undef if $nfk;
    $row->set_related($rn, my $r = $ri->{schema}->search({where => \@on}));
    $r;
}

sub has_many { ref $_[0] ? die shift->_dmsg_(1) : shift->_add_relation_(has_many => '*', @_) }

sub has_one { ref $_[0] ? die shift->_dmsg_(1) : shift->_add_relation_(has_one => 1, @_) }

sub _join_on_pk_ {
    my($sch, $rn, $f, $sn) = @_;
    my $s = $sn ? $sch->_parent_class_->$sn : $sch;
    my $pk = $s->primary_key;
    die $sch->_dmsg_(8, $rn).": No single-column primary_key on $s" if !$pk || @$pk != 1;
    [$rn.'.'.sprintf($f, $pk->[0])];
}

sub might_have { ref $_[0] ? die shift->_dmsg_(1) : shift->_add_relation_(might_have => '?', @_) }

sub _multiplicity_ {
    my $self = shift;
    die qq{No multiplicity(-m) for $self->$_[1]} if !$_[0];
    $self->MULTIPLICITY->{$_[0]} || die qq{Invalid multiplicity(-m) "$_[0]" for $self->$_[1]};
}

sub _org_id_ {
    my $row = shift;
    my $org = $row->{-org} || return undef;
    my $pk  = $row->primary_key || return undef;
    join(':', '', (map{ defined $org->{$_} ? $org->{$_} : return undef } @$pk), '');
}

sub relations { shift->_global_->{relations} }

sub relations_hash { shift->_global_->{relations_hash} }

sub _reverse_relation_ {
    my($row, $ri) = @_;
    
    if(!exists $ri->{_rev}){
        my $sch = $row->_class_;
        my %on = map{ $_->[1] => $_->[0] } @{$ri->{on}};
        my @rr = grep{
            $_->{schema} eq $sch
         && @{$_->{on}} == @{$ri->{on}}
         && !grep{ ($on{$_->[0]} || '') ne $_->[1] } @{$_->{on}}
        } @{$ri->{schema}->relations};
        $ri->{_rev} = !@rr ? undef : @rr == 1 ? $rr[0]->{name} : die;
    }
    my $rn = $ri->{_rev} || return;
    $ri->{schema}->relations_hash->{$rn} || die;
}

sub set_related {
    die $_[0]->_dmsg_(2) if !ref $_[0];
    my($row, $rn, $r) = @_;
    my $ri = $row->relations_hash->{$rn} || die qq{No such relation: "$rn"};
    my $rel = $row->{-rel}{$rn};
    my $dc = $rel && ($row->_data_->{cache} || die);
    my(@ins, @del);
    
    if($ri->{_multi}){ #has_many
        my(%org, $ign, @r);
        if($rel){
            foreach(@{$rel->[0]}){
                my $r = $dc->{$_} || die $_;
                $org{$r->_org_id_ || int $r} = $r;
            }
            $ign = $rel->[1] || {};
        }
        
        my @on = map{ [$_->[0] => $row->get_column($_->[1])] } @{$ri->{on}};
        foreach(@$r){
            my $r = $_;
            $r = $ri->{schema}->new($r) if ref $r eq 'HASH';
            my $id = $r->_org_id_;
            if($id && (my $org = delete $org{$id})){
                $r = $org;
            }elsif($id && $ign->{$id}){
                next
            }else{
                $r->set_column($_->[0], $_->[1]) for @on;
                push @ins, $r;
            }
            push @r, $r;
        }
        $row->{-rel}{$rn} = [$row->_add_to_cache_(\@r)];
        @del = values %org;
    }else{
        $r = $ri->{schema}->new($r) if ref $r eq 'HASH';
        if($ri->{type} eq 'belongs_to'){
            $row->set_column($_->[1], $r ? $r->get_column($_->[0]) : undef) for @{$ri->{on}};
        }elsif($r){ #has_one or might_have
            $r->set_column($_->[0], $row->get_column($_->[1])) for @{$ri->{on}};
        }
        $row->{-rel}{$rn} = $r ? $row->_add_to_cache_($ins[0] = $r) : undef;
        $del[0] = $dc->{$rel} || die $rel if $rel;
    }
    
    $row->_sync_relations_($ri, \@ins, \@del);
    $row;
}

sub _sync_relations_ {
    my($row, $ri, $ins, $del) = @_;
    my $rri = $row->_reverse_relation_($ri) || return;
    
    $_->_del_related_($rri, $row) for @$del;
    
    my $i = int $row;
    foreach my $r (@$ins){
        if($rri->{_multi}){
            my $rel = $r->{-rel}{$rri->{name}} ||= [[], {}];
            push @{$rel->[0]}, $i if !grep{ $_ == $i } @{$rel->[0]};
        }else{
            my $rel = $r->{-rel}{$rri->{name}};
            $r->_data_->{cache}{$rel}->_del_related_($ri, $r) if $rel;
            $r->{-rel}{$rri->{name}} = $i;
        }
    }
}

1;
